home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s3.arc / PIBFMANS.MOD < prev    next >
Encoding:
Text File  |  1987-05-19  |  34.1 KB  |  947 lines
  1. (*----------------------------------------------------------------------*)
  2. (*      View_Directory --- List files in current directory              *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE View_Directory;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  View_Directory                                       *)
  10. (*                                                                      *)
  11. (*     Purpose:    Lists files in current MSDOS directory               *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        View_Directory;                                               *)
  16. (*                                                                      *)
  17. (*     Calls:   View_Prompt                                             *)
  18. (*              Save_Screen                                             *)
  19. (*              Restore_Screen                                          *)
  20. (*              Draw_Menu_Frame                                         *)
  21. (*              Reset_Global_Colors                                     *)
  22. (*              Dir_Get_Default_Drive                                   *)
  23. (*              Dir_Get_Current_Path                                    *)
  24. (*              Dir_Find_First_File                                     *)
  25. (*              Dir_Find_Next_File                                      *)
  26. (*              Dir_Convert_Time                                        *)
  27. (*              Dir_Convert_Date                                        *)
  28. (*                                                                      *)
  29. (*----------------------------------------------------------------------*)
  30.  
  31. VAR
  32.    Iok                 : INTEGER;
  33.    Drive_Ch            : CHAR;
  34.    Cur_Drive_Ch        : CHAR;
  35.    File_Entry          : Directory_Record;
  36.    S_File_Name         : STRING[14];
  37.    S_File_Time         : STRING[8];
  38.    S_File_Date         : STRING[8];
  39.    S_File_Size         : REAL;
  40.    S_File_Xmodem_Time  : STRING[8];
  41.    S_File_Attributes   : STRING[6];
  42.    Fs1                 : REAL;
  43.    Fs2                 : REAL;
  44.    I                   : INTEGER;
  45.    J                   : INTEGER;
  46.    L                   : INTEGER;
  47.    Dir_Spec            : AnyStr;
  48.    View_Ch             : CHAR;
  49.    Total_File_Size     : REAL;
  50.    Total_File_Count    : INTEGER;
  51.    Free_Space          : REAL;
  52.    Path_Name           : AnyStr;
  53.    File_Ref_Name       : STRING[12];
  54.  
  55. LABEL
  56.    View_Exit;
  57.  
  58. BEGIN (* View_Directory *)
  59.                                    (*  Draw view menu *)
  60.  
  61.    Save_Partial_Screen( Saved_Screen, 5, 4, 75, 24 );
  62.    Draw_Menu_Frame( 5, 4, 75, 24, Menu_Frame_Color, Menu_Title_Color,
  63.                     Menu_Text_Color, 'View Directory' );
  64.  
  65.    Dir_Spec := '';
  66.    TextColor( Menu_Text_Color_2 );
  67.    WRITELN('Enter search specification (*.* for all): ');
  68.    WRITE  ('>');
  69.    TextColor( Menu_Text_Color );
  70.    Read_Edited_String( Dir_Spec );
  71.  
  72.    FOR I := 1 TO 3 DO
  73.       BEGIN
  74.          GoToXY( 1 , I );
  75.          ClrEol;
  76.       END;
  77.  
  78.    IF ( Dir_Spec = CHR( ESC ) ) THEN
  79.       GOTO View_Exit;
  80.                                    (* Get current drive and path if none given *)
  81.  
  82.    Drive_Ch      := Dir_Get_Default_Drive;
  83.    Cur_Drive_Ch  := Drive_Ch;
  84.    Iok           := Dir_Get_Current_Path( Drive_Ch , Path_Name );
  85.    File_Ref_Name := '*.*';
  86.  
  87.    IF ( Dir_Spec <> '' ) THEN
  88.       BEGIN
  89.                                    (* Get drive *)
  90.  
  91.          I := POS( ':' , Dir_Spec );
  92.          IF ( I <> 0 ) THEN
  93.             BEGIN
  94.                Drive_Ch  := Dir_Spec[1];
  95.                Dir_Spec  := Substr( Dir_Spec, I + 1, LENGTH( Dir_Spec ) - I );
  96.                IF( Drive_Ch <> Cur_Drive_Ch ) THEN
  97.                   Path_Name := '';
  98.             END
  99.          ELSE
  100.             Drive_Ch := Dir_Get_Default_Drive;
  101.  
  102.                                    (* Get path and file name *)
  103.  
  104.          IF ( POS( '\' , Dir_Spec ) = 0 ) THEN
  105.             File_Ref_Name := Dir_Spec
  106.          ELSE
  107.             BEGIN
  108.  
  109.                L := LENGTH( Dir_Spec );
  110.                J := L + 1;
  111.  
  112.                REPEAT
  113.                   J := J - 1;
  114.                UNTIL ( J <= 1 ) OR ( Dir_Spec[J] = '\' );
  115.  
  116.                Path_Name     := Substr( Dir_Spec, 1, J );
  117.                File_Ref_Name := Substr( Dir_Spec, J + 1, L - J );
  118.  
  119.             END;
  120.  
  121.       END;
  122.                                    (* Build wildcard for directory search *)
  123.    Dir_Spec := Drive_Ch + ':';
  124.  
  125.    IF ( Path_Name <> '' ) THEN
  126.       Dir_Spec := Dir_Spec + '\' + Path_Name + '\';
  127.  
  128.    IF ( File_Ref_Name <> '' ) THEN
  129.       Dir_Spec := Dir_Spec + File_Ref_Name
  130.    ELSE
  131.       Dir_Spec := Dir_Spec + '*.*';
  132.  
  133.    I := POS( '\\', Dir_Spec );
  134.  
  135.    WHILE ( I > 0 ) DO
  136.       BEGIN
  137.          DELETE( Dir_Spec, I, 1 );
  138.          I := POS( '\\', Dir_Spec );
  139.       END;
  140.                                    (* Display directory title *)
  141.  
  142.    RvsVideoOn( Menu_Text_Color , BLACK );
  143.  
  144.    GoToXY( 1 , 1 );
  145.  
  146.    WRITE('LISTING OF DIRECTORY: ',Dir_Spec);
  147.    ClrEol;
  148.    WRITELN;
  149.    WRITE('     File Name     Size     Date     Time  Attributes  Xfer Time');
  150.    ClrEol;
  151.    WRITELN;
  152.  
  153.    RvsVideoOff( Menu_Text_Color , BLACK );
  154.  
  155.                                    (* Reset window so header doesn't vanish *)
  156.    Window( 6, 7, 74, 23 );
  157.    GoToXY( 1 , WhereY );
  158.                                    (* List the directory contents   *)
  159.  
  160.    View_Count := 0;
  161.    View_Done  := ( Dir_Find_First_File( Dir_Spec, File_Entry ) <> 0 );
  162.  
  163.    Total_File_Size  := 0.0;
  164.    Total_File_Count := 0;
  165.  
  166.    WHILE( NOT View_Done ) DO
  167.       BEGIN
  168.                                    (* Display Next Directory Entry       *)
  169.          S_File_Name := '';
  170.          I           := 1;
  171.                                    (* Pick up file name *)
  172.  
  173.          WHILE( ( I <= 14 ) AND ( File_Entry.File_Name[I] <> CHR(0) ) ) DO
  174.             BEGIN
  175.                S_File_Name := S_File_Name + File_Entry.File_Name[I];
  176.                I           := I + 1;
  177.             END;
  178.                                    (* Pick up creation date and time *)
  179.  
  180.          Dir_Convert_Time( File_Entry.File_Time , S_File_Time );
  181.          Dir_Convert_Date( File_Entry.File_Date , S_File_Date );
  182.  
  183.                                    (* Pick up file size *)
  184.  
  185.          Fs1 := File_Entry.File_Size[1];
  186.          Fs2 := File_Entry.File_Size[2];
  187.  
  188.          IF Fs1 < 0 THEN Fs1 := Fs1 + 65536.0;
  189.          IF Fs2 < 0 THEN Fs2 := Fs2 + 65536.0;
  190.  
  191.          S_File_Size     := Fs2 * 65536.0 + Fs1;
  192.          Total_File_Size := Total_File_Size + S_File_Size;
  193.  
  194.                                    (* Pick up transfer time *)
  195.  
  196.          S_File_Xmodem_Time := TimeString( ROUND( ( S_File_Size / 128.0 ) + 0.49 ) *
  197.                                            ( Trans_Time_Val / Baud_Rate ) ,
  198.                                            Military_Time );
  199.  
  200.                                    (* Determine attributes *)
  201.          S_File_Attributes := '';
  202.  
  203.          WITH File_Entry DO
  204.             BEGIN
  205.                IF ( File_Attr AND Dir_Attr_Read_Only    ) <> 0 THEN
  206.                   S_File_Attributes := 'R';
  207.                IF ( File_Attr AND Dir_Attr_Hidden       ) <> 0 THEN
  208.                   S_File_Attributes := S_File_Attributes + 'H';
  209.                IF ( File_Attr AND Dir_Attr_System       ) <> 0 THEN
  210.                   S_File_Attributes := S_File_Attributes + 'S';
  211.                IF ( File_Attr AND Dir_Attr_Volume_Label ) <> 0 THEN
  212.                   S_File_Attributes := S_File_Attributes + 'V';
  213.                IF ( File_Attr AND Dir_Attr_Subdirectory ) <> 0 THEN
  214.                   S_File_Attributes := S_File_Attributes + 'D';
  215.                IF ( File_Attr AND Dir_Attr_Archive      ) <> 0 THEN
  216.                   S_File_Attributes := S_File_Attributes + 'A';
  217.             END;
  218.  
  219.          IF ( S_File_Attributes = '' ) THEN
  220.             S_File_Attributes := 'N';
  221.  
  222.                                    (* Display entry *)
  223.  
  224.          WRITELN( S_File_Name:14, ' ', S_File_Size:8:0, ' ', S_File_Date, ' ',
  225.                   S_File_Time,'  ',S_File_Attributes:10,'   ',
  226.                   S_File_Xmodem_Time );
  227.  
  228.                                    (* Increment count of lines displayed *)
  229.  
  230.          View_Count := View_Count + 1;
  231.  
  232.                                    (* Prompt if end of screen *)
  233.          IF View_Count > 15 THEN
  234.             View_Prompt( View_Done , View_Count );
  235.  
  236.                                    (* Increment file count *)
  237.  
  238.          Total_File_Count := Total_File_Count + 1;
  239.  
  240.          View_Done := View_Done OR ( Dir_Find_Next_File( File_Entry ) <> 0 );
  241.  
  242.    END;
  243.                                    (* Display total file size and free space *)
  244.    WRITELN;
  245.  
  246.    View_Count := View_Count + 1;
  247.    IF View_Count > 15 THEN
  248.       View_Prompt( View_Done , View_Count );
  249.  
  250.    Free_Space := Dir_Get_Free_Space( Drive_Ch );
  251.  
  252.    WRITELN( Total_File_Size:8:0, ' bytes in ', Total_File_Count, ' files; ',
  253.             Free_Space:8:0,' bytes free.');
  254.  
  255.    View_Count := View_Count + 1;
  256.    IF View_Count > 15 THEN
  257.       View_Prompt( View_Done , View_Count );
  258.  
  259.                                    (* Issue final end-of-directory prompt *)
  260.  
  261.    RvsVideoOn( Menu_Text_Color , BLACK );
  262.  
  263.    WRITE('Viewing of directory complete. ',
  264.          'Hit ESC to continue.');
  265.    ClrEol;
  266.  
  267.    RvsVideoOff( Menu_Text_Color , BLACK );
  268.  
  269.                                    (* Swallow terminating character *)
  270.    Read_Kbd( View_Ch );
  271.    IF ( View_Ch = CHR( ESC ) ) AND KeyPressed THEN
  272.       READ( Kbd, View_Ch );
  273.                                    (* Restore previous screen *)
  274. View_Exit:
  275.  
  276.    Restore_Screen( Saved_Screen );
  277.    Reset_Global_Colors;
  278.  
  279. END   (* View_Directory *);
  280.  
  281. (*----------------------------------------------------------------------*)
  282. (*      Log_Drive_Change --- Change current logged drive                *)
  283. (*----------------------------------------------------------------------*)
  284.  
  285. PROCEDURE Log_Drive_Change;
  286.  
  287. (*----------------------------------------------------------------------*)
  288. (*                                                                      *)
  289. (*     Procedure:  Log_Drive_Change                                     *)
  290. (*                                                                      *)
  291. (*     Purpose:    Change current logged drive                          *)
  292. (*                                                                      *)
  293. (*     Calling Sequence:                                                *)
  294. (*                                                                      *)
  295. (*        Log_Drive_Change                                              *)
  296. (*                                                                      *)
  297. (*     Calls:   Dir_Get_Default_Drive                                   *)
  298. (*              Dir_Set_Default_Drive                                   *)
  299. (*              Save_Screen                                             *)
  300. (*              Restore_Screen                                          *)
  301. (*              Draw_Menu_Frame                                         *)
  302. (*              Reset_Global_Colors                                     *)
  303. (*                                                                      *)
  304. (*                                                                      *)
  305. (*----------------------------------------------------------------------*)
  306.  
  307. VAR
  308.    Drive_Ch    : CHAR;
  309.    Drive_No    : INTEGER;
  310.    Drive_Count : INTEGER;
  311.  
  312. BEGIN (* Log_Drive_Change *);
  313.                                    (*  Draw logged drive change menu *)
  314.  
  315.    Save_Partial_Screen( Saved_Screen, 5, 10, 55, 15 );
  316.  
  317.    Draw_Menu_Frame( 5, 10, 55, 15, Menu_Frame_Color, Menu_Title_Color,
  318.                     Menu_Text_Color, 'Change Current Logged Drive' );
  319.  
  320.    GoToXY( 1 , 1 );
  321.    Drive_Ch := Dir_Get_Default_Drive;
  322.  
  323.    TextColor( Menu_Text_Color_2 );
  324.    WRITE('Current logged drive is: ');
  325.    TextColor( Menu_Text_Color );
  326.    WRITE( Drive_Ch );
  327.  
  328.    GoToXY( 1 , 2 );
  329.  
  330.    TextColor( Menu_Text_Color_2 );
  331.    WRITE('Enter letter for new logged drive: ');
  332.  
  333.    READ( Kbd , Drive_Ch );
  334.  
  335.    TextColor( Menu_Text_Color_2 );
  336.  
  337.    IF ( ( Drive_Ch = CHR( CR ) ) OR ( Drive_Ch = CHR( ESC ) ) ) THEN
  338.       BEGIN
  339.          WRITELN;
  340.          WRITELN('*** Logged drive remains unchanged.')
  341.       END
  342.    ELSE
  343.       BEGIN
  344.                                 (* Figure no. of drives in system *)
  345.  
  346.          TextColor( Menu_Text_Color );
  347.  
  348.          Drive_Ch := UpCase( Drive_Ch );
  349.  
  350.          WRITE( Drive_Ch );
  351.  
  352.          Drive_Count := Dir_Count_Drives;
  353.  
  354.                                 (* Drive no. for entered letter   *)
  355.  
  356.          Drive_No := ORD( Drive_Ch ) - ORD( 'A' );
  357.  
  358.                                 (* Check if drive legitimate      *)
  359.  
  360.          IF ( ( Drive_No < 0 ) OR ( Drive_No > Drive_Count ) ) THEN
  361.             WRITELN('*** Invalid drive, logged drive unchanged.')
  362.          ELSE
  363.             BEGIN
  364.                                 (* Change default drive *)
  365.  
  366.                Dir_Set_Default_Drive( Drive_Ch );
  367.  
  368.                TextColor( Menu_Text_Color_2 );
  369.  
  370.                WRITELN;
  371.                WRITE('*** Logged drive changed to ');
  372.  
  373.                TextColor( Menu_Text_Color );
  374.                WRITE( Drive_Ch );
  375.  
  376.             END;
  377.  
  378.       END;
  379.  
  380.    DELAY( Two_Second_Delay );
  381.  
  382.                                    (* Restore previous screen *)
  383.    Restore_Screen( Saved_Screen );
  384.    Reset_Global_Colors;
  385.  
  386. END   (* Log_Drive_Change *);
  387.  
  388. (*----------------------------------------------------------------------*)
  389. (*       Change_Subdirectory --- Change current disk subdirectory       *)
  390. (*----------------------------------------------------------------------*)
  391.  
  392. PROCEDURE Change_Subdirectory;
  393.  
  394. (*----------------------------------------------------------------------*)
  395. (*                                                                      *)
  396. (*     Procedure:  Change_Subdirectory                                  *)
  397. (*                                                                      *)
  398. (*     Purpose:    Change current subdirectory                          *)
  399. (*                                                                      *)
  400. (*     Calling Sequence:                                                *)
  401. (*                                                                      *)
  402. (*        Change_Subdirectory;                                          *)
  403. (*                                                                      *)
  404. (*     Calls:   Dir_Get_Default_Drive                                   *)
  405. (*              Dir_Set_Current_Path                                    *)
  406. (*              Dir_Get_Current_Path                                    *)
  407. (*              Save_Screen                                             *)
  408. (*              Restore_Screen                                          *)
  409. (*              Draw_Menu_Frame                                         *)
  410. (*              Reset_Global_Colors                                     *)
  411. (*                                                                      *)
  412. (*                                                                      *)
  413. (*----------------------------------------------------------------------*)
  414.  
  415. VAR
  416.    Path_Name   : AnyStr;
  417.    Iok         : INTEGER;
  418.    Drive_Ch    : CHAR;
  419.    New_Drive   : CHAR;
  420.    Drive_No    : INTEGER;
  421.    Drive_Count : INTEGER;
  422.  
  423. BEGIN (* Change_Subdirectory *)
  424.                                    (*  Draw directory change menu *)
  425.  
  426.    Save_Partial_Screen( Saved_Screen, 5, 10, 75, 15 );
  427.  
  428.    Draw_Menu_Frame( 5, 10, 75, 15, Menu_Frame_Color, Menu_Title_Color,
  429.                     Menu_Text_Color, 'Change Current Directory' );
  430.  
  431.    GoToXY( 1 , 1 );
  432.  
  433.    Drive_Ch  := Dir_Get_Default_Drive;
  434.  
  435.    Iok       := Dir_Get_Current_Path( Drive_Ch , Path_Name );
  436.  
  437.    IF ( Path_Name = '' ) THEN
  438.       Path_Name := Drive_Ch + ':'
  439.    ELSE
  440.       Path_Name := Drive_Ch + ':\' + Path_Name;
  441.  
  442.    TextColor( Menu_Text_Color_2 );
  443.    WRITELN('Enter name of new directory path: ');
  444.    WRITE  ('>');
  445.  
  446.    TextColor( Menu_Text_Color );
  447.    Read_Edited_String( Path_Name );
  448.  
  449.    WRITELN;
  450.  
  451.    TextColor( Menu_Text_Color_2 );
  452.  
  453.    IF ( ( LENGTH( Path_Name ) = 0 ) OR ( Path_Name = CHR( ESC ) ) ) THEN
  454.       WRITELN('*** Current directory remains unchanged.')
  455.    ELSE
  456.       BEGIN
  457.  
  458.          IF ( POS( ':' , Path_Name ) <> 0 ) THEN
  459.             IF ( UpCase( Path_Name[1] ) <> Drive_Ch ) THEN
  460.                BEGIN
  461.                   New_Drive   := UpCase( Path_Name[1] );
  462.                   Drive_Count := Dir_Count_Drives;
  463.                   Drive_No    := ORD( New_Drive ) - ORD( 'A' );
  464.                   IF ( Drive_No >= 0 ) AND ( Drive_No <= Drive_Count ) THEN
  465.                      Dir_Set_Default_Drive( New_Drive );
  466.                END;
  467.  
  468.          IF Dir_Set_Current_Path( Path_Name ) = 0 THEN
  469.             BEGIN
  470.                Drive_Ch := Dir_Get_Default_Drive;
  471.                Iok := Dir_Get_Current_Path( Drive_Ch , Path_Name );
  472.                IF Path_Name <> '' THEN
  473.                   WRITELN('*** Current directory changed to ',
  474.                           Drive_Ch + ':\' + Path_Name )
  475.                ELSE
  476.                   WRITELN('*** Current directory changed to ',
  477.                           Drive_Ch + ':' );
  478.             END
  479.          ELSE
  480.             WRITELN('*** Error found, directory not changed');
  481.       END;
  482.  
  483.    DELAY( Two_Second_Delay );
  484.  
  485.                                    (* Restore previous screen *)
  486.    Restore_Screen( Saved_Screen );
  487.    Reset_Global_Colors;
  488.  
  489. END   (* Change_Subdirectory *);
  490.  
  491. (*----------------------------------------------------------------------*)
  492. (*               Delete_A_File --- Delete a file                        *)
  493. (*----------------------------------------------------------------------*)
  494.  
  495. PROCEDURE Delete_A_File;
  496.  
  497. (*----------------------------------------------------------------------*)
  498. (*                                                                      *)
  499. (*     Procedure:  Delete_A_File                                        *)
  500. (*                                                                      *)
  501. (*     Purpose:    Delete file in current subdirectory                  *)
  502. (*                                                                      *)
  503. (*     Calling Sequence:                                                *)
  504. (*                                                                      *)
  505. (*        Delete_A_File;                                                *)
  506. (*                                                                      *)
  507. (*     Calls:   Dir_Delete_File                                         *)
  508. (*              Save_Screen                                             *)
  509. (*              Restore_Screen                                          *)
  510. (*              Draw_Menu_Frame                                         *)
  511. (*              Reset_Global_Colors                                     *)
  512. (*                                                                      *)
  513. (*----------------------------------------------------------------------*)
  514.  
  515. VAR
  516.    File_Name : AnyStr;
  517.  
  518. BEGIN (* Delete_A_File *)
  519.                                    (*  Draw delete file menu *)
  520.  
  521.    Save_Partial_Screen( Saved_Screen, 5, 10, 75, 15 );
  522.  
  523.    Draw_Menu_Frame( 5, 10, 75, 15, Menu_Frame_Color, Menu_Title_Color,
  524.                     Menu_Text_Color, 'Delete A File -- Be Careful!' );
  525.  
  526.    TextColor( Menu_Text_Color_2 );
  527.  
  528.    GoToXY( 1 , 1 );
  529.  
  530.    WRITELN('Enter name of file to delete: ');
  531.    WRITE('>');
  532.  
  533.    File_Name := '';
  534.  
  535.    TextColor( Menu_Text_Color );
  536.  
  537.    Read_Edited_String( File_Name );
  538.    WRITELN;
  539.  
  540.    TextColor( Menu_Text_Color_2 );
  541.  
  542.    IF ( ( LENGTH( File_Name ) = 0 ) OR ( File_Name = CHR( ESC ) ) ) THEN
  543.       WRITELN('*** No file to delete.')
  544.    ELSE
  545.       IF ( Dir_Delete_File( File_Name ) = 0 ) THEN
  546.          WRITELN('*** File deleted.')
  547.       ELSE
  548.          WRITELN('*** File not found to delete or read-only');
  549.  
  550.    DELAY( Two_Second_Delay );
  551.  
  552.                                    (* Restore previous screen *)
  553.    Restore_Screen( Saved_Screen );
  554.    Reset_Global_Colors;
  555.  
  556. END   (* Delete_A_File *);
  557.  
  558. (*----------------------------------------------------------------------*)
  559. (*        Find_Free_Space_On_Drive --- Find free space on a drive       *)
  560. (*----------------------------------------------------------------------*)
  561.  
  562. PROCEDURE Find_Free_Space_On_Drive;
  563.  
  564. (*----------------------------------------------------------------------*)
  565. (*                                                                      *)
  566. (*     Procedure:  Find_Free_Space_On_Drive                             *)
  567. (*                                                                      *)
  568. (*     Purpose:    Finds free space on a drive                          *)
  569. (*                                                                      *)
  570. (*     Calling Sequence:                                                *)
  571. (*                                                                      *)
  572. (*        Find_Free_Space_On_Drive;                                     *)
  573. (*                                                                      *)
  574. (*     Calls:   Dir_Get_Free_Space                                      *)
  575. (*              Save_Screen                                             *)
  576. (*              Restore_Screen                                          *)
  577. (*              Draw_Menu_Frame                                         *)
  578. (*              Reset_Global_Colors                                     *)
  579. (*                                                                      *)
  580. (*----------------------------------------------------------------------*)
  581.  
  582. VAR
  583.    Drive_Ch: CHAR;
  584.    Fspace:   REAL;
  585.  
  586. BEGIN (* Find_Free_Space_On_Drive *)
  587.  
  588.    Save_Partial_Screen( Saved_Screen, 10, 10, 61, 15 );
  589.  
  590.    Draw_Menu_Frame( 10, 10, 61, 15, Menu_Frame_Color, Menu_Title_Color,
  591.                     Menu_Text_Color, 'Free space on drive' );
  592.  
  593.    REPEAT
  594.       GoToXY( 1 , 1 );
  595.       ClrEol;
  596.       Drive_CH := ' ';
  597.       TextColor( Menu_Text_Color_2 );
  598.       WRITE('Which drive? ');
  599.       Read_Kbd( Drive_Ch );
  600.       IF ( ( Drive_Ch = CHR( CR ) ) OR ( Drive_Ch = CHR( ESC ) ) ) THEN
  601.          Drive_Ch := ' ';
  602.       TextColor( Menu_Text_Color );
  603.       WRITE( Drive_Ch );
  604.       Drive_Ch := UpCase( Drive_Ch );
  605.    UNTIL( Drive_Ch IN [' ','A'..'Z'] );
  606.  
  607.    TextColor( Menu_Text_Color_2 );
  608.  
  609.    IF Drive_Ch <> ' ' THEN
  610.       BEGIN
  611.          WRITELN;
  612.          FSpace := Dir_Get_Free_Space( Drive_Ch );
  613.          IF Fspace > 0.0 THEN
  614.             WRITELN('Free space on drive ',Drive_Ch,' is ',Fspace:8:0,' bytes')
  615.          ELSE
  616.             WRITELN('Can''t find free space for drive ',Drive_Ch);
  617.  
  618.          WRITELN(' ');
  619.          WRITE  ('Hit ESC to continue');
  620.  
  621.          Read_Kbd( Drive_Ch );
  622.  
  623.          IF ( Drive_Ch = CHR( ESC ) ) AND KeyPressed THEN
  624.             READ( Kbd, Drive_Ch );
  625.  
  626.       END;
  627.  
  628.    Restore_Screen( Saved_Screen );
  629.    Reset_Global_Colors;
  630.  
  631. END   (* Find_Free_Space_On_Drive *);
  632.  
  633. (*----------------------------------------------------------------------*)
  634. (*                    Copy_A_File  --- Copy a file                      *)
  635. (*----------------------------------------------------------------------*)
  636.  
  637. PROCEDURE Copy_A_File;
  638.  
  639. (*----------------------------------------------------------------------*)
  640. (*                                                                      *)
  641. (*     Procedure:  Copy_A_File                                          *)
  642. (*                                                                      *)
  643. (*     Purpose:    Copies a file                                        *)
  644. (*                                                                      *)
  645. (*     Calling Sequence:                                                *)
  646. (*                                                                      *)
  647. (*        Copy_A_File;                                                  *)
  648. (*                                                                      *)
  649. (*     Calls:                                                           *)
  650. (*              Save_Screen                                             *)
  651. (*              Restore_Screen                                          *)
  652. (*              Draw_Menu_Frame                                         *)
  653. (*              Reset_Global_Colors                                     *)
  654. (*              Open_File_Handle                                        *)
  655. (*              Create_File_Handle                                      *)
  656. (*              Close_File_Handle                                       *)
  657. (*              Read_File_Handle                                        *)
  658. (*              Write_File_Handle                                       *)
  659. (*                                                                      *)
  660. (*----------------------------------------------------------------------*)
  661.  
  662. CONST
  663.    BufSize =  4096                 (* Buffer size       *);
  664.  
  665. VAR
  666.    F_Handle   : INTEGER            (* File to be copied *);
  667.    F_Size     : REAL               (* Size of file      *);
  668.    F_Open     : BOOLEAN            (* If F opened OK    *);
  669.    G_Handle   : INTEGER            (* File copied to    *);
  670.    G_Open     : BOOLEAN            (* If G opened OK    *);
  671.    G_Size     : REAL               (* Size of G         *);
  672.    F_Name     : AnyStr             (* Input file name   *);
  673.    G_Name     : AnyStr             (* Output file name  *);
  674.    Abort_Copy : BOOLEAN            (* TRUE to stop copy *);
  675.  
  676.    BytesRead  : INTEGER            (* # of bytes read   *);
  677.    BytesDone  : REAL               (* Total bytes read  *);
  678.  
  679.                                    (* Buffer area       *)
  680.    Buffer     : PACKED ARRAY[ 1 .. BufSize ] OF CHAR;
  681.  
  682.    Err        : INTEGER            (* I/O error flag    *);
  683.    QErr       : BOOLEAN            (* If error occurs   *);
  684.  
  685. LABEL
  686.    Abort_It;
  687.  
  688. BEGIN (* Copy_A_File *)
  689.                                    (* Announce file copy *)
  690.  
  691.    Save_Partial_Screen( Saved_Screen, 5, 10, 75, 17 );
  692.  
  693.    Draw_Menu_Frame( 5, 10, 75, 17, Menu_Frame_Color, Menu_Title_Color,
  694.                     Menu_Text_Color, 'Copy a file' );
  695.  
  696.    Abort_Copy := FALSE;
  697.    Qerr       := FALSE;
  698.                                    (* Get name of file to copy *)
  699.    REPEAT
  700.  
  701.       TextColor( Menu_Text_Color_2 );
  702.       GoToXY( 1 , 1 );
  703.       WRITE(' Enter file to be copied:    ');
  704.       ClrEol;
  705.       F_Name := '';
  706.  
  707.       TextColor( Menu_Text_Color );
  708.       Read_Edited_String( F_Name );
  709.  
  710.       IF ( ( LENGTH( F_Name ) = 0 ) OR ( F_Name = CHR( ESC ) ) ) THEN
  711.          Abort_Copy := TRUE
  712.       ELSE
  713.          F_Size := Get_File_Size( F_Name, F_Open )
  714.  
  715.    UNTIL ( F_Open OR Abort_Copy );
  716.  
  717.                                    (* Stop if no input file *)
  718.  
  719.    IF Abort_Copy THEN GOTO Abort_It;
  720.  
  721.                                    (* Get name of file to copy to *)
  722.    REPEAT
  723.  
  724.       TextColor( Menu_Text_Color_2 );
  725.       GoToXY( 1 , 2 );
  726.       WRITE(' Enter file to receive copy: ');
  727.       ClrEol;
  728.       G_Name := '';
  729.       TextColor( Menu_Text_Color );
  730.       Read_Edited_String( G_Name );
  731.  
  732.       IF ( ( LENGTH( G_Name ) = 0 ) OR ( G_Name = CHR( ESC ) ) ) THEN
  733.          Abort_Copy := TRUE
  734.       ELSE
  735.          G_Size := Get_File_Size( G_Name, G_Open );
  736.  
  737.       IF G_Open THEN
  738.          BEGIN
  739.             GoToXY( 1 , 3 );
  740.             G_Open := NOT YesNo(' File already exists, overwrite (Y/N)? ');
  741.          END;
  742.  
  743.    UNTIL ( ( NOT G_Open ) OR Abort_Copy );
  744.  
  745.                                    (* Open input file *)
  746.  
  747.    Err := Open_File_Handle( F_Name, Access_Read_Mode, F_Handle );
  748.  
  749.                                    (* Open output file *)
  750.  
  751.    Err := Create_File_Handle( G_Name , Attribute_None , G_Handle );
  752.  
  753.                                    (* Report file size *)
  754.    TextColor( Menu_Text_Color_2 );
  755.  
  756.    GoToXY( 1 , 4 );
  757.    WRITE('Size of file ',F_Name,' in bytes is ',F_Size:8:0 );
  758.  
  759.    GoToXY( 1 , 5 );
  760.    WRITE('Bytes copied: ');
  761.  
  762.    BytesDone := 0.0;
  763.                                    (* Perform the copy *)
  764.    REPEAT
  765.  
  766.       BytesRead := BufSize;
  767.  
  768.       Err := Read_File_Handle( F_Handle, Buffer, BytesRead );
  769.  
  770.       IF ( Err <> 0 ) THEN
  771.          BEGIN
  772.             GoToXY( 1 , 6 );
  773.             WRITE('Error reading input file, copy stops.');
  774.             Qerr := TRUE;
  775.          END;
  776.  
  777.       IF ( ( BytesRead > 0 ) AND ( NOT Qerr ) ) THEN
  778.          BEGIN
  779.             Err := Write_File_Handle( G_Handle, Buffer, BytesRead );
  780.             IF ( Err <> 0 ) THEN
  781.                BEGIN
  782.                   GoToXY( 1 , 6 );
  783.                   WRITE('Error writing output file, copy stops.');
  784.                   Qerr := TRUE;
  785.                END;
  786.          END;
  787.  
  788.       BytesDone := BytesDone + BytesRead;
  789.  
  790.       GoToXY( 15 , 5 );
  791.       WRITE( BytesDone:8:0 );
  792.  
  793.    UNTIL ( ( BytesRead < BufSize ) OR Qerr );
  794.  
  795.                                    (* Close files  *)
  796.  
  797.    Err := Close_File_Handle( F_Handle );
  798.    Err := Close_File_Handle( G_Handle );
  799.  
  800.    GoToXY( 1 , 6 );
  801.  
  802.    IF ( NOT Qerr ) THEN
  803.       WRITE('Copy complete.');
  804.  
  805.    DELAY( Two_Second_Delay );
  806.  
  807. Abort_It:
  808.                                    (* Restore previous screen *)
  809.    Restore_Screen( Saved_Screen );
  810.    Reset_Global_Colors;
  811.  
  812. END   (* Copy_A_File *);
  813.  
  814. (*----------------------------------------------------------------------*)
  815. (*              Print_A_File  --- Initiate printing of a file           *)
  816. (*----------------------------------------------------------------------*)
  817.  
  818. PROCEDURE Print_A_File;
  819.  
  820. (*----------------------------------------------------------------------*)
  821. (*                                                                      *)
  822. (*     Procedure:  Print_A_File                                         *)
  823. (*                                                                      *)
  824. (*     Purpose:    Initiates printing of a file                         *)
  825. (*                                                                      *)
  826. (*     Calling Sequence:                                                *)
  827. (*                                                                      *)
  828. (*        Print_A_File;                                                 *)
  829. (*                                                                      *)
  830. (*     Calls:                                                           *)
  831. (*              Save_Screen                                             *)
  832. (*              Restore_Screen                                          *)
  833. (*              Draw_Menu_Frame                                         *)
  834. (*              Reset_Global_Colors                                     *)
  835. (*                                                                      *)
  836. (*----------------------------------------------------------------------*)
  837.  
  838. VAR
  839.    F_Name      : AnyStr;
  840.    F_Open      : BOOLEAN;
  841.    Abort_Print : BOOLEAN;
  842.    F_Size      : REAL;
  843.    Err         : INTEGER;
  844.  
  845. BEGIN (* Print_A_File *)
  846.                                    (* Announce file print *)
  847.  
  848.    Save_Partial_Screen( Saved_Screen, 5, 10, 75, 15 );
  849.  
  850.    Draw_Menu_Frame( 5, 10, 75, 15, Menu_Frame_Color, Menu_Title_Color,
  851.                     Menu_Text_Color, 'Print a file' );
  852.  
  853.                                    (* Print a file not allowed      *)
  854.                                    (* if logging session to printer *)
  855.  
  856.    TextColor( Menu_Text_Color_2 );
  857.  
  858.    IF Printer_On THEN
  859.       BEGIN
  860.          WRITELN('Can''t print a file while session logging active.');
  861.          DELAY( Two_Second_Delay );
  862.          Restore_Screen( Saved_Screen );
  863.          Reset_Global_Colors;
  864.          EXIT;
  865.       END;
  866.                                    (* Currently spooling -- see if *)
  867.                                    (* we are to stop.              *)
  868.    IF Print_Spooling THEN
  869.       BEGIN
  870.          F_Open := YesNo('File already being printed, stop it (Y/N)? ');
  871.          IF F_Open THEN
  872.             BEGIN
  873.                Print_Spooling := FALSE;
  874.                Err            := Close_File_Handle( Spool_File_Handle );
  875.                DISPOSE( Spool_Buffer );
  876.             END
  877.          ELSE
  878.             BEGIN
  879.                Restore_Screen( Saved_Screen );
  880.                Reset_Global_Colors;
  881.                EXIT;
  882.             END;
  883.       END;
  884.  
  885.    Abort_Print := FALSE;
  886.    F_Open      := FALSE;
  887.                                    (* Get name of file to copy *)
  888.    REPEAT
  889.  
  890.       GoToXY( 1 , 1 );
  891.       WRITE(' Enter file to be printed:    ');
  892.       ClrEol;
  893.       F_Name := '';
  894.       TextColor( Menu_Text_Color );
  895.       Read_Edited_String( F_Name );
  896.       WRITELN;
  897.       TextColor( Menu_Text_Color_2 );
  898.  
  899.       IF ( ( LENGTH( F_Name ) > 0 ) AND ( F_Name <> CHR( ESC ) ) ) THEN
  900.          BEGIN
  901.             F_Size := Get_File_Size( F_Name, F_Open );
  902.             IF ( NOT F_Open ) THEN
  903.                BEGIN
  904.                   WRITE('Can''t open that file.');
  905.                   ClrEol;
  906.                   DELAY( Two_Second_Delay );
  907.                   GoToXY( 1 , WhereY );
  908.                   ClrEol;
  909.                END;
  910.           END
  911.       ELSE
  912.          Abort_Print := TRUE;
  913.  
  914.    UNTIL ( F_Open OR Abort_Print );
  915.  
  916.                                    (* Stop if no file to print *)
  917.    IF ( NOT Abort_Print ) THEN
  918.       BEGIN
  919.                                    (* Open file to print and read in *)
  920.                                    (* first buffer full of data      *)
  921.  
  922.          Err := Open_File_Handle( F_Name, Access_Read_Mode,
  923.                                   Spool_File_Handle );
  924.  
  925.          NEW( Spool_Buffer );
  926.  
  927.          Spool_Buffer_Count := Max_Spool_Buffer_Count;
  928.  
  929.          Err := Read_File_Handle( Spool_File_Handle, Spool_Buffer^,
  930.                                   Spool_Buffer_Count );
  931.  
  932.          Spool_Buffer_Pos := 0;
  933.  
  934.          Print_Spooling := TRUE;
  935.  
  936.          WRITELN;
  937.          WRITELN('File ',F_Name,' starting to print.');
  938.          DELAY( Two_Second_Delay );
  939.  
  940.       END;
  941.                                    (* Restore previous screen *)
  942.    Restore_Screen( Saved_Screen );
  943.    Reset_Global_Colors;
  944.  
  945. END   (* Print_A_File *);
  946.  
  947.